(ns clojure-demo.maze
  (:use [clojure.java.io]))


;Wilson迷宫生成算法。
;Jamis Buck at http://weblog.jamisbuck.org/2011/2/7/maze-generation-algorithm-recap

;Wilson的算法是一个雕刻算法，它从一个全是墙、没有路径的迷宫开始，
;然后通过从这个迷宫中移除一些墙来雕刻出一个迷宫。

;规则如下：
;-1，随机选择一个坐标，把它标记成已经访问过。
;-2，随机选择一个还没有访问过的坐标，如果没有的话，那么返回这个迷宫。
;-3，从这个新选的坐标开始，在这个迷宫里面做一个随机的遍历，直到碰到一个已经访问过的坐标。
;若果在一次随机遍历过程中经过一个坐标多次，那么记住每次离开这个坐标的方向。
;-4，把这个随机遍历经过的所有坐标标记为已经访问过的，
;然后根据每个坐标的最后离开方向，把这个路径上的墙都拆掉。
;-5，从第2步开始重复。

;这个算法有这些实体：坐标，访问过的状态，这个迷宫本身，随机遍历，离开方向。

;-1，用一个向量来表示坐标：[x y]。
;-2，用一个set来保存访问过的坐标。
;-3，迷宫本身是由墙组成的，而一堵墙处于两个坐标之间，因此一堵墙可以表示成含有两个坐标的set。
;-4，迷宫则是一个墙的set。
;-5，遍历其实就是坐标的序列。
;-6，离开方向其实就是从离开的坐标到它新进入的坐标，可以用两个坐标的向量表示。

(defn maze
    "Returns a random maze carved out of walls; walls is a set of
    2-item sets #{a b} where a and b are locations.
    The returned maze is a set of the remaining walls."
    [walls]
    (let [paths (reduce (fn [index [a b]] 
                            (merge-with into index {a [b] b [a]}))
                        {} 
                        (map seq walls))
          start-loc (rand-nth (keys paths))] 
        (loop [ walls walls
                unvisited (disj (set (keys paths)) start-loc)] 
              (if-let [loc (when-let [s (seq unvisited)] (rand-nth s))] 
                      (let [walk (iterate (comp rand-nth paths) loc) 
                            steps (zipmap (take-while unvisited walk) (next walk))] 
                           (recur (reduce disj walls (map set steps)) 
                                  (reduce disj unvisited (keys steps))))
                      walls))))

;两个工具函数，grid用来创建一个全是墙的迷宫。draw用来渲染生成好的迷宫，这里使用swing。

(defn grid
    [w h]
    (set (concat
            (for [i (range (dec w)) j (range h)] #{[i j] [(inc i) j]})
            (for [i (range w) j (range (dec h))] #{[i j] [i (inc j)]}))))

(defn draw
    [w h maze]
    (doto   (javax.swing.JFrame. "Maze")
            (.setContentPane
                (doto (proxy [javax.swing.JPanel] []
                             (paintComponent [^java.awt.Graphics g]
                                (let [g (doto ^java.awt.Graphics2D (.create g)
                                            (.scale 10 10)
                                            (.translate 1.5 1.5)
                                            (.setStroke (java.awt.BasicStroke. 0.4)))]
                                     (.drawRect g -1 -1 w h)

                                     (doseq [ [[xa ya] [xb yb]] (map sort maze)]
                                            (let [ [xc yc] (if (= xa xb)
                                                   [(dec xa) ya]
                                                   [xa (dec ya)])]
                                                 (.drawLine g xa ya xc yc))))))
                        (.setPreferredSize (java.awt.Dimension.
                            (* 10 (inc w)) (* 10 (inc h))))))
            .pack
            (.setVisible true)))

(draw 40 40 (maze (grid 40 40)))

;====
;真正的Wilson算法。

;前面实现的并不是一个真正的Wilson算法。
;前面的代码，当随机遍历碰到一个已经在我们的迷宫中的坐标时，
;我们把这个随机遍历中经过的所有坐标都加入到这个迷宫里面去了，
;而不仅仅是这个子路径（从起点到终点）。
;显然我们的算法比Wilson算法要快，因为它每次添加的坐标更多。
;但是Wilson的卖点是每一种迷宫生成出来的几率是一样的。

;一个真正的Wilson算法只是加多两行代码。

(defn wmaze
    "The original Wilson's algorithm."
    [walls]
    (let [  paths (reduce (fn [index [a b]]
                              (merge-with into index {a [b] b [a]}))
                           {} (map seq walls))
            start-loc (rand-nth (keys paths)) ]
        (loop   [walls walls unvisited (disj (set (keys paths)) start-loc)]
                (if-let [loc (when-let [s (seq unvisited)] (rand-nth s))]
                    (let [walk (iterate (comp rand-nth paths) loc)
                          steps (zipmap (take-while unvisited walk) (next walk))
                          walk (take-while identity (iterate steps loc))    ;这里只追溯随机遍历的最近的分支，从loc开始。
                          steps (zipmap walk (next walk)) ]        ;把这个路径变成一个map，每个元素是一个[from-loc to-loc]键值对。
                        (recur  (reduce disj walls (map set steps))
                                (reduce disj unvisited (keys steps))))
                        walls))))

;Generating Random Spanning Trees More Quickly than the Cover Timeby David Bruce Wilson 
;http://citeseer.ist.psu.edu/viewdoc/summary?doi=10.1.1.47.8598

;注意，maze函数不关心一个坐标是怎么表示的，只要它不是nil或false。
;所以maze可以处理任何拓扑的迷宫。
;下面的代码生成一个六边形的迷宫。

(defn hex-grid
    [w h]
    (let [  vertices (set (for  [y (range h) x (range (if (odd? y) 1 0) (* 2 w) 2)]
                                [x y]))
            deltas [[2 0] [1 1] [-1 1]] ]
        (set (for  [v vertices d deltas f [+ -]
                    :let [w (vertices (map f v d))]
                    :when w] 
                   #{v w}))))


(defn- hex-outer-walls
    [w h]
    (let [vertices (set (for [y (range h) x (range (if (odd? y) 1 0) (* 2 w) 2)]
                             [x y]))
          deltas [[2 0] [1 1] [-1 1]] ]
        (set (for [ v vertices d deltas f [+ -]
                    :let [w (map f v d)]
                    :when (not (vertices w))]
                  #{v (vec w)}))))

(defn hex-draw
    [w h maze]
    (doto   (javax.swing.JFrame. "Maze")
            (.setContentPane
                (doto   (proxy [javax.swing.JPanel] []
                        (paintComponent [^java.awt.Graphics g]
                        (let [  maze (into maze (hex-outer-walls w h))
                                g (doto ^java.awt.Graphics2D (.create g)
                                        (.scale 10 10)
                                        (.translate 1.5 1.5)
                                        (.setStroke (java.awt.BasicStroke. 0.4
                                            java.awt.BasicStroke/CAP_ROUND
                                            java.awt.BasicStroke/JOIN_MITER)))
                                draw-line (fn   [ [[xa ya] [xb yb]] ]
                                                (.draw g
                                                    (java.awt.geom.Line2D$Double.
                                                        xa (* 2 ya) xb (* 2 yb))))]
                            (doseq [[[xa ya] [xb yb]] (map sort maze)]
                                (draw-line
                                    (cond
                                        (= ya yb) [[(inc xa) (+ ya 0.4)] [(inc xa) (- ya 0.4)]]
                                        (< ya yb) [[(inc xa) (+ ya 0.4)] [xa (+ ya 0.6)]]
                                        :else [ [(inc xa) (- ya 0.4)] [xa (- ya 0.6)] ]))))))
                        (.setPreferredSize (java.awt.Dimension.
                        (* 20 (inc w)) (* 20 (+ 0.5 h))))))
            .pack
            (.setVisible true)))

(hex-draw 40 40 (maze (hex-grid 40 40)))

;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;
(require '[clojure.zip :as z])

(def v [[1 2 [3 4]] [5 6]])
;= #'user/v

(-> v z/vector-zip z/node)
;= [[1 2 [3 4]] [5 6]]

(-> v z/vector-zip z/down z/node)
;= [1 2 [3 4]]

(-> v z/vector-zip z/down z/right z/node)
;= [5 6]

;https://en.wikipedia.org/wiki/Ariadne

(-> v z/vector-zip z/down z/right (z/replace 56) z/node)
;= 56

;z/vector-zip 和 z/root一起配合构建了一个事务的边界。

(-> v z/vector-zip z/down z/right (z/replace 56) z/root) 
;= [[1 2 [3 4]] 56]

;z/remove把zipper移到深度优先遍历的前一个位置。

(-> v z/vector-zip z/down z/right z/remove z/node) 
;= 4

(-> v z/vector-zip z/down z/right z/remove z/root)
;= [[1 2 [3 4]]]

(-> v z/vector-zip z/down z/down z/right (z/edit * 42) z/root) 
;= [[1 84 [3 4]] [5 6]]

;;;;;;;;;;;;;;;;;;;
(defn html-zip [root]
    (z/zipper
        vector?
        (fn [[tagname & xs]]
            (if (map? (first xs)) (next xs) xs))
        (fn [[tagname & xs] children]
            (into (if (map? (first xs)) [tagname (first xs)] [tagname])
                  children))
        root))

(defn wrap
       "Wraps the current node in the specified tag and attributes."
       (   [loc tag]
           (z/edit loc #(vector tag %)))
       (   [loc tag attrs]
           (z/edit loc #(vector tag attrs %))))
   
(def h  [:body [:h1 "Clojure"]
           [:p "What a wonderful language!"]])
;= #'user/h
   
(-> h html-zip z/down z/right z/down (wrap :b) z/root)
;= [:body [:h1 "Clojure"] [:p [:b "What a wonderful language!"]]]

;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;
;======
;定义一个迷宫。

;全是墙的迷宫：
(def labyrinth (maze (grid 10 10)))

;除去一些墙的迷宫：
(def labyrinth (let [g (grid 10 10)] (reduce disj g (maze g))))

;忒修斯：
(def theseus (rand-nth (distinct (apply concat labyrinth))))

;牛头怪：
(def minotaur (rand-nth (distinct (apply concat labyrinth))))

;--
;以方向作为节点。
(defn ariadne-zip
    [labyrinth loc]
    (let [  paths (reduce  (fn  [index [a b]]
                                (merge-with into index {a [b] b [a]}))
                           {} (map seq labyrinth))
            children (fn [[from to]]
                         (seq (for [loc (paths to) 
                                    :when (not= loc from)]
                                   [to loc])))]
        (z/zipper   (constantly true)    ;因为所有的坐标都可能通向另外其它的坐标。
                    children
                    nil    ;因为这个zipper是完全只读遍历的。
                    [nil loc])))    ;初始方向，起点。

;--
;对迷宫进行一个深度优先遍历就能找到牛头怪。

(->> theseus
    (ariadne-zip labyrinth)
    (iterate z/next)
    (filter #(= minotaur (second (z/node %))))
    first z/path
    (map second))
;=	([3 9] [4 9] [4 8] [4 7] [4 6] [5 7] [5 6] [5 5] [5 4]
;	[5 8] [6 8] [6 7] [6 6] [6 5] [7 6] [8 6] [9 6] [9 5]
;	[9 4] [9 3] [9 2] [9 1] [9 0] [8 2] [8 1] [8 0] [7 0]
;	[6 0] [7 1] [7 2] [6 2] [6 1] [5 1] [4 1] [4 0] [5 0]
;	[3 0] [4 2] [5 2] [3 2] [3 3] [4 3] [4 4] [4 5] [3 5])

;图形化。
(defn draw
    [w h maze path]
    (doto   (javax.swing.JFrame. "Maze")
            (.setContentPane
                (doto   (proxy [javax.swing.JPanel] []
                        (paintComponent [^java.awt.Graphics g]
                            (let    [g (doto ^java.awt.Graphics2D (.create g)
                                            (.scale 10 10)
                                            (.translate 1.5 1.5)
                                            (.setStroke (java.awt.BasicStroke. 0.4)))]
                                    (.drawRect g -1 -1 w h)
                                    (doseq  [[[xa ya] [xb yb]] (map sort maze)]
                                            (let [[xc yc] (if (= xa xb)
                                                              [(dec xa) ya]
                                                              [xa (dec ya)])]
                                                 (.drawLine g xa ya xc yc)))
                                    (.translate g -0.5 -0.5)
                                    (.setColor g java.awt.Color/RED)
                                    (doseq  [[[xa ya] [xb yb]] path]    ;path保存的是一个个坐标对
                                            (.drawLine g xa ya xb yb)))))
                        (.setPreferredSize (java.awt.Dimension.
                                                (* 10 (inc w)) (* 10 (inc h))))))
            .pack
            (.setVisible true)))


(let [  w 40, h 40
        grid (grid w h)
        walls (maze grid)
        labyrinth (reduce disj grid walls)
        places (distinct (apply concat labyrinth))
        theseus (rand-nth places)
        minotaur (rand-nth places)
        path (->>   theseus
                    (ariadne-zip labyrinth)
                    (iterate z/next)
                    (filter #(= minotaur (first (z/node %))))
                    first 
                    z/path 
                    rest) ]    ;这里用rest代替了(map second)，因为路径的第一个坐标是起点，它前面没有别的坐标。
     (draw w h walls path))

